Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue56/System/RASControls.pas

Pascal/Delphi Source File | 2000-02-09 | 15.7 KB | 439 lines

unit RASControls;

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
    TRasDialParams = record
    dwSize: Integer;
    EntryName: array [0..256] of Char;
    PhoneNumber: array [0..128] of Char;
    CallbackNumber: array [0..128] of Char;
    UserName: array [0..256] of Char;
    Password: array [0..256] of Char;
    Domain: array [0..15] of Char;
    end;

    TRasDialParamsNT4_2000 = record
    dwSize: Integer;
    EntryName: array [0..256] of Char;
    PhoneNumber: array [0..128] of Char;
    CallbackNumber: array [0..128] of Char;
    UserName: array [0..256] of Char;
    Password: array [0..256] of Char;
    Domain: array [0..15] of Char;
        SubEntry: Integer;
        CallbackId: Integer;
    end;

    TRasEntry = record
    dwSize, Options: Integer;                                                     // General stuff
    CountryID, CountryCode: Integer;                                              // Phone/Country info
    AreaCode: array [0..10] of Char;
    LocalPhoneNumber: array [0..128] of Char;
    AlternateOffset: Integer;
    ipaddr, ipaddrDns, ipaddrDnsAlt, ipaddrWins, ipaddrWinsAlt: Integer;          // PPP/Ip
    FrameSize, NetProtocols, FramingProtocol: Integer;                            // Framing
    Script: array [0..Max_Path - 1] of Char;                                      // Scripting
    AutodialDll: array [0..Max_Path - 1] of Char;                                 // AutoDial
    AutodialFunc: array [0..Max_Path - 1] of Char;
    DeviceType: array [0..16] of Char;                                            // Device
    DeviceName: array [0..128] of Char;
    X25PadType: array [0..32] of Char;                                            // X.25
    X25Address: array [0..200] of Char;
    X25Facilities: array [0..200] of Char;
    X25UserData: array [0..200] of Char;
    Channels: Integer;
    Reserved1, Reserved2: Integer;
    end;

    TRASBaseComponent = class (TComponent)
    private
        { Private declarations }
        fErrorText: String;
        fError: Integer;
        fOnError: TNotifyEvent;
        fRasLib, fRasExtensionsLib: THandle;
        fWin2000, fWinNT4, fAvailable, fDummy1: Boolean;
        function GetProc (ProcName: PChar): Pointer;
        function CallProc (Err: Integer): Boolean;
    public
        { Public declarations }
        constructor Create (AOwner: TComponent); override;
        destructor Destroy; override;
        property ErrorText: String read fErrorText;
        property Error: Integer read fError;
    published
        { Published declarations }
        property Available: Boolean read fAvailable write fDummy1 stored False;
        property OnError: TNotifyEvent read fOnError write fOnError;
    end;

    TRASPhoneBookManager = class (TRASBaseComponent)
    private
        { Private declarations }
        fItemIndex: Integer;
        fEntries, fDummy2: TStrings;
        fPhoneBookFileName, fDummy3: String;
        procedure SetItemIndex (Value: Integer);
        function PhoneBookNameAsPChar: PChar;
        procedure SetPhoneBookFileName (const Value: String);
        function GetDialParameters (Index: Integer): String;
        function GetEntryProperties (Index: Integer): String;
        function InternalGetDialParameters (var Dest: TRasDialParamsNT4_2000; var GotPassword: Bool): Integer;
        function InternalGetEntryProperties (var Dest: TRASEntry): Boolean;
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create (AOwner: TComponent); override;
        destructor Destroy; override;
        function Add: Boolean;
        function Delete: Boolean;
        function Edit: Boolean;
        function Rename (const NewName: String): Boolean;
        function ValidateEntryName (const EntryName: String): Boolean;
        procedure Refresh;
    published
        { Published declarations }
        property ItemIndex: Integer read fItemIndex write SetItemIndex stored False;
        property PhoneBookFileName: String read fPhoneBookFileName write SetPhoneBookFileName;
        property Entries: TStrings read fEntries write fDummy2 stored False;
        property UserName: String index 0 read GetDialParameters write fDummy3 stored False;
        property Password: String index 1 read GetDialParameters write fDummy3 stored False;
        property PhoneNumber: String index 0 read GetEntryProperties write fDummy3 stored False;
        property DeviceType: String index 1 read GetEntryProperties write fDummy3 stored False;
        property DeviceName: String index 2 read GetEntryProperties write fDummy3 stored False;
    end;

procedure Register;

implementation

// TRASBaseComponent

constructor TRASBaseComponent.Create (AOwner: TComponent);
begin
    Inherited Create (AOwner);
    fRasLib := LoadLibrary ('rasapi32.dll');
    fRasExtensionsLib := LoadLibrary ('rnaph.dll');
    fAvailable := fRasLib <> 0;
    fWin2000 := (Win32Platform = Ver_Platform_Win32_NT) and (Win32MajorVersion >= 5);
    fWinNT4 := (Win32Platform = Ver_Platform_Win32_NT) and (Win32MajorVersion = 4);
end;

destructor TRASBaseComponent.Destroy;
begin
    if fRasLib <> 0 then FreeLibrary (fRasLib);
    if fRasExtensionsLib <> 0 then FreeLibrary (fRasExtensionsLib);
    Inherited;
end;

function TRASBaseComponent.GetProc (ProcName: PChar): Pointer;
begin
    Result := Nil;
    if fAvailable then begin
        Result := GetProcAddress (fRasLib, ProcName);
        if (Result = Nil) and (fRasExtensionsLib <> 0) then
            Result := GetProcAddress (fRasExtensionsLib, ProcName);
    end;
end;

function TRASBaseComponent.CallProc (Err: Integer): Boolean;
var
    szErr: array [0..1024] of Char;
    RasGetErrorString: function (Err: Integer; Buff: PChar; BuffSize: Integer): Integer; stdcall;
begin
    fError := Err;  Result := Err = 0;
    if Result then fErrorText := '' else begin
       RasGetErrorString := GetProc ('RasGetErrorStringA');
       if RasGetErrorString (Err, szErr, sizeof (szErr)) = 0 then fErrorText := szErr else begin
           fErrorText := SysErrorMessage (Err);
           if fErrorText = '' then fErrorText := Format ('Unknown error (%d)', [Err]);
       end;

       fErrorText := 'RAS: ' + fErrorText;
       if Assigned (fOnError) then fOnError (Self);
    end;
end;

// TRASPhoneBook

constructor TRASPhoneBookManager.Create (AOwner: TComponent);
begin
    Inherited Create (AOwner);
    fEntries := TStringList.Create;
    Refresh;
end;

destructor TRASPhoneBookManager.Destroy;
begin
    fEntries.Free;
    Inherited;
end;

procedure TRASPhoneBookManager.SetPhoneBookFileName (const Value: String);
begin
    if (fPhoneBookFileName <> Value) and FileExists (Value) then begin
        fPhoneBookFileName := Value;
        Refresh;
    end;
end;

function TRASPhoneBookManager.PhoneBookNameAsPChar: PChar;
begin
    if fPhoneBookFileName = '' then
        Result := Nil else Result := PChar (fPhoneBookFileName);
end;

procedure TRASPhoneBookManager.Refresh;
type
    TRasEntryName = record
        dwSize: Integer;
    szEntryName: array [0..257] of Char;
    end;

    TRasEntryName2000 = record
        dwSize: Integer;
    szEntryName: array [0..257] of Char;
        dwFlags: Integer;
        szPhonebookPath: array [0..Max_Path] of Char;
    end;
var
    CurEntry, Buffer: PChar;
    Idx, BufSize, NumEntries, EntrySize: Integer;
    RasEnumEntries: function (Reserved, Phonebook, Buffer: PChar;
                              var BufSize, NumEntries: Integer): Integer; stdcall;
begin
    if fAvailable then begin
        // First off, refresh the entries list
        fEntries.Clear;
        RasEnumEntries := GetProc ('RasEnumEntriesA');
        EntrySize := sizeof (TRasEntryName);
        if fWin2000 then EntrySize := sizeof (TRasEntryName2000);

        // Make a dummy call to get the wanted buffer size
        Idx := EntrySize; BufSize := sizeof (Idx);
        RasEnumEntries (Nil, PhoneBookNameAsPChar, @Idx, BufSize, NumEntries);

        // Now do it for real
        Buffer := AllocMem (BufSize);
        try
           PInteger (Buffer)^ := EntrySize;
           if CallProc (RasEnumEntries (Nil, PhoneBookNameAsPChar, Buffer, BufSize, NumEntries)) then begin
               CurEntry := Buffer;
                for Idx := 0 to NumEntries - 1 do begin
                    fEntries.Add (CurEntry + sizeof (Integer));
                    Inc (CurEntry, EntrySize);
                end;
            end;
        finally
            FreeMem (Buffer);
            if fEntries.Count > 0 then fItemIndex := 0 else fItemIndex := -1;
        end;
    end;
end;

procedure TRASPhoneBookManager.SetItemIndex (Value: Integer);
begin
    if (Value >= 0) and (Value < fEntries.Count) and (fEntries.Count > 0) then fItemIndex := Value;
end;

function TRASPhoneBookManager.Add: Boolean;
var
    RasCreatePhoneBookEntry: function (WndParent: hWnd; Phonebook: PChar): Integer; stdcall;
begin
    Result := False;
    if fAvailable then begin
       RasCreatePhoneBookEntry := GetProc ('RasCreatePhonebookEntryA');
       if Assigned (RasCreatePhoneBookEntry) then
           Result := CallProc (RasCreatePhoneBookEntry (Application.Handle, PhoneBookNameAsPChar));
       if Result then Refresh;
    end;
end;

function TRASPhoneBookManager.Delete: Boolean;
var
    RasDeleteEntry: function (Phonebook, EntryName: PChar): Integer; stdcall;
begin
    Result := False;
    if fAvailable and (fItemIndex >= 0) then begin
       RasDeleteEntry := GetProc ('RasDeleteEntryA');
       if Assigned (RasDeleteEntry) then Result := CallProc (RasDeleteEntry (PhoneBookNameAsPChar, PChar (fEntries [fItemIndex])));
       if Result then Refresh;
    end;
end;

function TRASPhoneBookManager.Edit: Boolean;
var
    RasEditPhonebookEntry: function (WndParent: hWnd; Phonebook, EntryName: PChar): Integer; stdcall;
begin
    Result := False;
    if fAvailable and (fItemIndex >= 0) then begin
       RasEditPhonebookEntry := GetProc ('RasEditPhonebookEntryA');
       if Assigned (RasEditPhonebookEntry) then
           Result := CallProc (RasEditPhonebookEntry (Application.Handle, PhoneBookNameAsPChar, PChar (fEntries [fItemIndex])));
       if Result then Refresh;
    end;
end;

function TRASPhoneBookManager.ValidateEntryName (const EntryName: String): Boolean;
var
    RasValidateEntryName: function (Phonebook, EntryName: PChar): Integer; stdcall;
begin
    Result := False;
    if fAvailable then begin
       RasValidateEntryName := GetProc ('RasValidateEntryNameA');
       if Assigned (RasValidateEntryName) then Result := CallProc (RasValidateEntryName (PhoneBookNameAsPChar, PChar (EntryName)));
    end;
end;

function TRASPhoneBookManager.Rename (const NewName: String): Boolean;
var
    RasRenameEntry: function (Phonebook, OldName, NewName: PChar): Integer; stdcall;
begin
    Result := False;
    if fAvailable and (fItemIndex >= 0) and ValidateEntryName (NewName) then begin
       RasRenameEntry := GetProc ('RasRenameEntryA');
       if Assigned (RasRenameEntry) then
           Result := CallProc (RasRenameEntry (PhoneBookNameAsPChar, PChar (fEntries [fItemIndex]), PChar (NewName)));
       if Result then Refresh;
    end;
end;

function TRASPhoneBookManager.InternalGetDialParameters (var Dest: TRasDialParamsNT4_2000; var GotPassword: Bool): Integer;
var
    RasGetEntryDialParams: function (Phonebook: PChar; var RasDialParams: TRasDialParamsNT4_2000; var GotPassword: Bool): Integer; stdcall;
begin
    Result := 0;
    if fAvailable and (fItemIndex >= 0) then begin
        RasGetEntryDialParams := GetProc ('RasGetEntryDialParamsA');
        if Assigned (RasGetEntryDialParams) then begin
            if fWin2000 or fWinNT4 then Dest.dwSize := sizeof (TRasDialParamsNT4_2000)
            else Dest.dwSize := sizeof (TRasDialParams);
            StrPCopy (Dest.EntryName, fEntries [fItemIndex]);
            if CallProc (RasGetEntryDialParams (PhoneBookNameAsPChar, Dest, GotPassword)) then Result := Dest.dwSize;
        end;
    end;
end;

function TRASPhoneBookManager.GetDialParameters (Index: Integer): String;
var
    GotPassword: Bool;
    Params: TRasDialParamsNT4_2000;
begin
    if InternalGetDialParameters (Params, GotPassword) > 0 then begin
        if not GotPassword then Params.Password := '---not available----';
        case Index of
            0:     Result := Params.UserName;
            1:     Result := Params.Password;
        end;
    end;
end;

function TRASPhoneBookManager.InternalGetEntryProperties (var Dest: TRASEntry): Boolean;
var
    EntrySize, DevInfoSize: Integer;
    Buffer: array [0..10000] of Char;
    RasGetEntryProperties: function (Phonebook, EntryName: PChar; var Entry; var EntrySize: Integer;
                                     DevInfo: Pointer; var DevInfoSize: Integer): Integer; stdcall;
begin
    Result := False;
    if fAvailable and (fItemIndex >= 0) then begin
        RasGetEntryProperties := GetProc ('RasGetEntryPropertiesA');
        if Assigned (RasGetEntryProperties) then begin
            PInteger (@Buffer)^ := sizeof (TRASEntry);
            EntrySize := sizeof (Buffer);  DevInfoSize := 0;
            Result := CallProc (RasGetEntryProperties (PhoneBookNameAsPChar, PChar (fEntries [fItemIndex]), Buffer, EntrySize, Nil, DevInfoSize));
            if Result then Move (Buffer, Dest, sizeof (TRASEntry));
        end;
    end;
end;

function TRASPhoneBookManager.GetEntryProperties (Index: Integer): String;
var
    Props: TRASEntry;
begin
    if InternalGetEntryProperties (Props) then begin
        case Index of
            0:     Result := Props.LocalPhoneNumber;
            1:     Result := Props.DeviceType;
            2:     Result := Props.DeviceName;
        end;
    end;
end;

procedure Register;
begin
    RegisterComponents ('DelphiMag', [TRASPhoneBookManager]);
end;

end.

    TRASPhoneBookManager = class (TRASBaseComponent)
    private
        { Private declarations }
        fDeviceNames, fDeviceTypes, fDummy2: TStrings;
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create (AOwner: TComponent); override;
        destructor Destroy; override;
        procedure Refresh;
    published
        { Published declarations }
        property DeviceNames: TStrings read fDeviceNames write fDummy2 stored False;
        property DeviceTypes: TStrings read fDeviceTypes write fDummy2 stored False;
    end;


constructor TRASPhoneBook.Create (AOwner: TComponent);
begin
    Inherited Create (AOwner);
    fDeviceNames := TStringList.Create;
    fDeviceTypes := TStringList.Create;
    Refresh;
end;

destructor TRASPhoneBook.Destroy;
begin
    fDeviceNames.Free;
    fDeviceTypes.Free;
    Inherited;
end;

procedure TRASPhoneBook.Refresh;
type
    TRasDevInfo = record
    dwSize: DWORD;
    DeviceType: array [0..16] of Char;
    DeviceName: array [0..128] of Char;
    end;
var
    CurEntry: PChar;
    Buffer: array [0..10000] of Char;
    Idx, BufSize, NumDevices, EntrySize: Integer;
    RasEnumDevices: function (Buffer: PChar; var BufSize,
                              NumDevices: Integer): Integer; stdcall;
begin
    if fAvailable then begin
        // First off, refresh the entries list
        fDeviceNames.Clear;
        fDeviceTypes.Clear;
        RasEnumDevices := GetProc ('RasEnumDevicesA');
        EntrySize := sizeof (TRasDevInfo);
        PInteger (@Buffer)^ := EntrySize;  BufSize := sizeof (Buffer);
        RasEnumDevices (Buffer, BufSize, NumDevices);
        CurEntry := Buffer;
        for Idx := 0 to NumDevices - 1 do begin
            fDeviceTypes.Add (CurEntry + sizeof (Integer));
            fDeviceNames.Add (CurEntry + sizeof (Integer) + 17);
            Inc (CurEntry, EntrySize);
        end;
    end;
end;